﻿unit QFHttpService;

interface

uses
  SysUtils, SynCommons, SynDB, EncdDecd, IdCoderMIME,
  SynCrtSock, QFLog, QFAuthentication, SynZip, Classes,QFUnit,
  Forms, StrUtils, HttpApp,IdGlobal;

type
  THttpsSys = class
  private
    fHttpApiServer: THttpApiServer;
    fProps: TSQLDBConnectionProperties;
    fHttpPort, fHttpsPort: SockString;
    fThreadNum: integer;
    fAuthentication: TAuthentication;
    /// <summary>
    /// 处理HTTP请求
    /// </summary>
    /// <param name="Ctxt">请求对象</param>
    /// <returns>200-成功，其它-失败</returns>
    function Process(Ctxt: THttpServerRequest): cardinal;
    // function getStr(const source, sbegin, send: SockString): SockString;

    function GetDBFieldList(list: TStringList; Ctxt: THttpServerRequest)
      : cardinal;

    /// <summary>
    /// 查询SQL
    /// </summary>
    /// <param name="list"></param>
    /// <param name="Ctxt"></param>
    /// <returns></returns>
    function Query(list: TStringList; Ctxt: THttpServerRequest): cardinal;
    function QueryEx(list: TStringList; Ctxt: THttpServerRequest): cardinal;
    /// <summary>
    /// 执行事物SQL
    /// </summary>
    /// <param name="list"></param>
    /// <param name="Ctxt"></param>
    /// <returns></returns>
    function Execute(list: TStringList): cardinal;
    /// <summary>
    /// 客户端退出
    /// </summary>
    /// <param name="list"></param>
    /// <param name="Ctxt"></param>
    /// <returns></returns>
    function Quit(list: TStringList): cardinal;
  public
    /// <summary>
    /// 创建者方法
    /// </summary>
    /// <param name="prop">数据库连接</param>
    /// <param name="httpPort">http绑定端口</param>
    /// <param name="httpsPort">https绑定端口</param>
    /// <param name="threadnum">开启线程数量</param>
    /// <param name="Authentication">验证SESSION</param>
    constructor Create(props: TSQLDBConnectionProperties;
      const httpPort, httpsPort: SockString; threadnum: integer;
      Authentication: TAuthentication = nil);
    destructor Destroy; override;
    property HttpApiServer: THttpApiServer read fHttpApiServer;
  end;

implementation

{ THttpsSys }

constructor THttpsSys.Create(props: TSQLDBConnectionProperties;
  const httpPort, httpsPort: SockString; threadnum: integer;
  Authentication: TAuthentication);
begin
  fProps := props;
  fHttpPort := httpPort;
  fHttpsPort := httpsPort;
  fThreadNum := threadnum;
  fAuthentication := Authentication;

  fHttpApiServer := THttpApiServer.Create(True); // https.sys rest server
  fHttpApiServer.RegisterCompress(CompressGZip); // 压缩
  fHttpApiServer.Clone(fThreadNum); // 创建N个工作线程
  fHttpApiServer.AddUrl('', fHttpPort, False, '+', True); // 注册http URL
  fHttpApiServer.AddUrl('', fHttpsPort, True, '+', True); // 注册https url
  fHttpApiServer.OnRequest := Process; // 处理通信事件
  fHttpApiServer.Start;
end;

destructor THttpsSys.Destroy;
begin
  fHttpApiServer.Shutdown;
  fHttpApiServer.Free;
  fHttpApiServer := nil;

  inherited;
end;

function split(src, dec: string): TStringList;
var
  i: integer;
  str: string;
begin
  result := TStringList.Create;
  repeat
    i := pos(dec, src);
    str := copy(src, 1, i - 1);
    if (str = '') and (i > 0) then
    begin
      delete(src, 1, length(dec));
      continue;
    end;
    if i > 0 then
    begin
      result.Add(str);
      delete(src, 1, i + length(dec) - 1);
    end;
  until i <= 0;
  if src <> '' then
    result.Add(src);
end;

function THttpsSys.Execute(list: TStringList): cardinal;
var
  doc: TDocVariantData;
  ex: TQuery;
  i: integer;
  sql, sql1, sql2, blobs: string; // RawUTF8;
  bl: Variant;
  j, k: int64;
  MemoryStream: TMemoryStream;
begin
  // 客户端发送的sql参数是一个JSON数组：["insert into t2(c1) values (''cxg17'')","update...","delete from..."]
  // 因此要逐条执行数组的每一个json字符串
  doc.InitJSONInPlace(Pointer(RawUTF8(list.Values['sql'])),
    JSON_OPTIONS_FAST_STRICTJSON);
  ex := TQuery.Create(fProps.ThreadSafeConnection);
  try
    ex.Close;
    ex.sql.Clear;
    try
      blobs := '';
      if QFDBType = 'MSSQL' then
      begin
        for i := 0 to doc.Count - 1 do
        begin
          sql := doc.Value[i] + ';';
          if pos(':bl'+#$FFFE, sql) > 0 then//Blob
          begin
            sql1 := copy(sql, 1, pos(#$FFFE, sql) - 1);
            for j := pos(#$FFFE, sql) + 1 to length(sql) do
            begin
              if sql[j] <> #$FFFE then
              begin
                blobs := blobs + sql[j];
              end
              else
              begin
                sql2 := copy(sql, j + 1, length(sql));
                break;
              end;
            end;
            sql := sql1 + sql2;
          end;
          log.log(sllSQL, sql);
          ex.sql.Add(sql);
          if blobs<>'' then
            ex.ParamByName('bl').AsBytes:=QFBase64DeCode(blobs);//Blob
        end;
        if sql <> '' then
          ex.ExecSQL;
      end
      else
      begin
        for i := 0 to doc.Count - 1 do
        begin
          blobs := '';
          sql := doc.Value[i];
          if pos(':bl'+#$FFFE, sql) > 0 then//Blob
          begin
            sql1 := copy(sql, 1, pos(#$FFFE, sql) - 1);
            for j := pos(#$FFFE, sql) + 1 to length(sql) do
            begin
              if sql[j] <> #$FFFE then
              begin
                blobs := blobs + sql[j];
              end
              else
              begin
                sql2 := copy(sql, j + 1, length(sql));
                break;
              end;
            end;
            sql := sql1 + sql2;
          end;
          log.log(sllSQL, sql);
          ex.sql.Clear;
          ex.sql.Add(sql);
          if blobs<>'' then
            ex.ParamByName('bl').AsBytes:=QFBase64DeCode(blobs);//Blob
          if sql <> '' then
            ex.ExecSQL;
        end;
      end;
      result := 200;
    except
      on E: Exception do
      begin
        result := iExecuteSqlErr;
        log.log(sllError, 'executeSQL() ' + E.Message);
      end;
    end;
  finally
    ex.Free;
  end;
end;

function THttpsSys.Process(Ctxt: THttpServerRequest): cardinal;
var
  FN, cmd { , sql } : RawUTF8;
  list: TStringList;
begin
  // 为了简单，只支持http POST，不支持HTTP GET
  result := 404;
  list := nil;
  if Ctxt = nil then
    exit;
  Ctxt.OutContentType := JSON_CONTENT_TYPE;
  try
    // 解码
    FN := StringReplaceChars(UrlDecode(Ctxt.InContent), '/', '\');
    list := split(FN, '&');
    cmd := list.Values['cmd'];
    // 只有合法的SESSION才能请求服务
    if fAuthentication <> nil then
      if not SameText(cmd, sAUTHENTICATION_USER) then
        if not fAuthentication.SessionExists
          (StrToIntDef(list.Values['sessionid'], 0)) then
        begin
          result := iNoAuthentication; // 非法SESSION
          exit;
        end;
    // 处理命令字------------------------------------------------------------------
    if SameText(cmd, sQUIT) then // 客户端退出
    begin
      result := Quit(list);
    end
    else if SameText(cmd, sGetTableFields) then // 取字段列表
    begin
      result := GetDBFieldList(list, Ctxt);
    end
    else if SameText(cmd, sQUERY_SQL) then // 查询非事务SQL
    begin
      result := Query(list, Ctxt);
    end
    else if SameText(cmd, sQUERYEx_SQL) then // 查询非事务SQL
    begin
      result := QueryEx(list, Ctxt);
    end
    else if SameText(cmd, sEXECUTE_SQL) then // 执行事务SQL
    begin
      result := Execute(list);
    end
    else if SameText(cmd, sAUTHENTICATION_USER) then // 验证SESSION
    begin
      if fAuthentication <> nil then
        if fAuthentication.checkUser(list.Values['user'],
          list.Values['password']) then
        begin
          fAuthentication.CreateSession
            (StrToIntDef(list.Values['sessionid'], 0));
          result := 200;
        end
        else
        begin
          result := iUserOrPasswordError;
        end
      else
        result := 200;
    end
    else
    begin
      result := iInvalidRequest; // 不能识别的HTTP请求
    end;
  finally
    if list <> nil then
      list.Free;
  end;
end;

function THttpsSys.GetDBFieldList(list: TStringList; Ctxt: THttpServerRequest)
  : cardinal;
var
  COLName: TSQLDBColumnDefineDynArray;
  TableName: RawUTF8;
  SQLTXT: RawUTF8;
  i, j: integer;
begin
  try
    TableName := list.Values['TableName'];
    fProps.GetFields(TableName, COLName);
    i := length(COLName);
    SQLTXT := '{"FieldType":[';
    SQLTXT := '[';
    for j := 0 to i - 1 do
    begin
      SQLTXT := SQLTXT + '{"ColumnName":"' + COLName[j].ColumnName +
        '","ColumnTypeNative":"' + COLName[j].ColumnTypeNative +
        '","ColumnLength":' + COLName[j].ColumnLength.ToString +
        ',"ColumnPrecision":' + COLName[j].ColumnPrecision.ToString +
        ',"ColumnIndexed":' + COLName[j].ColumnIndexed.ToString + '},';
    end;
    SQLTXT := copy(SQLTXT, 1, length(SQLTXT) - 1);
    Ctxt.OutContent := HttpEncode(UTF8Encode(SQLTXT + ']'));
    result := 200;
  except
    on E: Exception do
    begin
      result := iQuerySqlErr;
      log.log(sllError, 'GetFields ' + E.Message);
    end;
  end;

end;

function THttpsSys.Query(list: TStringList; Ctxt: THttpServerRequest): cardinal;
var
  sql: RawUTF8;
begin
  try
    sql := list.Values['sql'];
    log.log(sllSQL, sql);
    Ctxt.OutContent := fProps.Execute(sql, []).FetchAllAsJSON(True);
    result := 200;
  except
    on E: Exception do
    begin
      result := iQuerySqlErr;
      log.log(sllError, 'querySQL() ' + E.Message);
    end;
  end;
end;

function THttpsSys.QueryEx(list: TStringList; Ctxt: THttpServerRequest)
  : cardinal;
var
  sql: RawUTF8;
  PageSizes: int64;
  PageNos: int64;
  PageSize: RawUTF8;
  PageNo: RawUTF8;
  TableName: RawUTF8;
  err: integer;
begin
  try
    TableName := list.Values['TableName'];
    PageSize := list.Values['PageSize'];
    PageNo := list.Values['PageNo'];
    TableName := list.Values['TableName'];
    val(PageNo, PageNos, err);
    val(PageSize, PageSizes, err);
    if QFDBType = 'MSSQL' then
    begin
      sql := 'select TOP ' + PageSize + ' * from ' + TableName +
        ' WHERE ID NOT IN (SELECT TOP ' + (PageSizes * PageNos).ToString +
        '  ID FROM  ' + TableName + ' ORDER BY ID ASC) ORDER BY ID ASC';
    end;

    log.log(sllSQL, sql);
    Ctxt.OutContent := fProps.Execute(sql, []).FetchAllAsJSON(True);
    result := 200;
  except
    on E: Exception do
    begin
      result := iQuerySqlErr;
      log.log(sllError, 'querySQL() ' + E.Message);
    end;
  end;
end;

function THttpsSys.Quit(list: TStringList): cardinal;
begin
  if fAuthentication <> nil then
    fAuthentication.RemoveSession(StrToIntDef(list.Values['sessionid'], 0));
  result := 200;
end;

end.
